home *** CD-ROM | disk | FTP | other *** search
/ Libris Britannia 4 / science library(b).zip / science library(b) / ASTRONOM / 0880.ZIP / PLANMERG.BAS < prev    next >
BASIC Source File  |  1980-01-01  |  9KB  |  72 lines
  1. 30150 IWH=301:ON ERROR GOTO 30600:LOCATE 1,1:PRINT"Please wait...":IPL=1
  2. 30152 DIM PL(7,1):P=TJ#*(TJ#*.0003011#+149474.07078#)+178.179078#:GOSUB 16400:PL=P*RF:PA=.3870986#:PE=TJ#*(TJ#*(-.00000003#)+.00002046#)+.20561421#:PII=(TJ#*(TJ#*(-.0000183#)+.0018608#)+7.002881#)*RF:PO=(TJ#*(TJ#*.0001739#+1.1852083#)+47.145944#)*RF
  3. 30155 DEF SEG:POKE &H4E,3:RA=RAMO:DEC=DECMO:GOSUB 20000:JY=20:KN=0:GOSUB 30465:IF Z=0 THEN 30160 ELSE CIRCLE(X,Y),2,3:PSET(X,Y),IC2
  4. 30157 IF FI=0 THEN TD=COS(XLAM-SLED)*COS(XB):TN=SQR(1-TD*TD):GOSUB 16300:T=PI#-T-.00256214328#*(1#-.0549*SIN(TMPU))*TN/(1#-.0167*SIN(SMA)):FI=(.5+COS(T)/2)*100
  5. 30160 RA=SUNRA:DEC=SUNDEC:GOSUB 20000:KN=3:JY=17:GOSUB 30465:IF Z<>0 THEN PUT(X-5,Y-5),SU%,OR
  6. 30165 P=TJ#*(TJ#*.000007#+149472.51529#)+102.27938#:GOSUB 16400:PM=P*RF:JY=19:KN=1:GOSUB 30450:IF Z<>0 THEN PUT(X-2,Y-4),S1%,OR
  7. 30175 P=TJ#*(TJ#*.0003097#+58519.21191#)+342.767053#:GOSUB 16400:PL=P*RF:PA=.7233316#:PE=TJ#*(TJ#*.000000091#-.00004774#)+.00682069#:PII=(TJ#*(TJ#*(-.000001#)+.0010058#)+3.393631#)*RF:PO=(TJ#*(TJ#*.00041#+.89985#)+75.779647#)*RF
  8. 30180 P=TJ#*(TJ#*.001286#+58517.80387#)+212.60322#:GOSUB 16400:PM=P*RF:KN=2:JY=20:GOSUB 30450:IF Z<>0 THEN PUT(X-2,Y-4),S2%,OR
  9. 30195 P=TJ#*(TJ#*.0003107#+19141.69551#)+293.737334#:GOSUB 16400:PL=P*RF:PA=1.5236883#:PE=TJ#*(TJ#*(-.000000077#)+.000092064#)+.0933129#:PII=(TJ#*(TJ#*.0000126#-.000675#)+1.850333#)*RF:PO=(TJ#*(TJ#*(TJ#*(-.00000533#)-.0000014#)+.7709917#)+48.786442#)*RF
  10. 30200 P=TJ#*(TJ#*.000181#+19139.85475#)+319.51913#:GOSUB 16400:PM=P*RF:KN=4:JY=18:GOSUB 30450:IF Z<>0 THEN PUT(X-2,Y-4),S4%,OR
  11. 30215 P=TJ#*(TJ#*(TJ#*(-.00000165#)+.0003347#)+3036.301986#)+238.049257#:GOSUB 16400:PL=P*RF:PA=5.202561#:PE=TJ#*(TJ#*(TJ#*(-.0000000017#)-.0000004676#)+.00016418#)+.04833475#:PII=(TJ#*(TJ#*.0000039#-.0056961#)+1.308736)*RF
  12. 30230 PO=(TJ#*(TJ#*(TJ#*(-.00000851#)+.00035222#)+1.01053#)+99.443414#)*RF:P=TJ#*(TJ#*(-.000722#)+3034.69202#)+225.32833#:GOSUB 16400:PM=P*RF:KN=5:JY=19:GOSUB 30450:IF Z<>0 THEN PUT(X-2,Y-4),S5%,OR
  13. 30235 P=TJ#*(TJ#*(TJ#*(-.0000058#)+.0003245#)+1223.509884#)+266.564377#:GOSUB 16400:PL=P*RF:PA=9.554747#:PE=TJ#*(TJ#*(TJ#*.00000000074#-.000000728#)-.0003455#)+.05589232#:PII=(TJ#*(TJ#*(TJ#*.00000004#-.00001549#)-.0039189#)+2.492519#)*RF
  14. 30250 PO=(TJ#*(TJ#*(TJ#*(-.00000531#)-.00015218#)+.8731951#)+112.790414#)*RF:P=TJ#*(TJ#*(-.000502#)+1221.55147#)+175.46622#:GOSUB 16400:PM=P*RF:KN=6:JY=18:GOSUB 30450:IF Z<>0 THEN PUT(X-2,Y-4),S6%,OR
  15. 30255 GOSUB 30500:CME=.967276#:CMI=162.23928#*RF:CMP=111.84809#*RF:CMO=58.14536#*RF:CMA=.5871047#/(1#-CME):CMN=.985609#/(CMA*SQR(CMA)):CMT#=2446470.95175#:GOSUB 30550:JY=20:KN=7:GOSUB 30465:IF Z<>0 THEN PUT(X-1,Y-2),H%,OR
  16. 30445 ICR=0:LOCATE 1,1:PRINT STRING$(14,32):ON ERROR GOTO 9000:GOTO 6440
  17. 30450 P=PM:EP=PE:GOSUB 16990:PE1=E0:R1=PA*(1#-PE*COS(PE1)):TN=SQR(1#+PE)*SIN(PE1/2#):TD=SQR(1#-PE)*COS(PE1/2#):GOSUB 16300:TV=2#*T:U1=PL+TV-PM-PO:SU=SIN(U1):TN=COS(PII)*SU:TD=COS(U1):GOSUB 16300:PEL=T+PO:TN=SU*SIN(PII):RSB=TN*R1
  18. 30455 GOSUB 16250:PB=T:RCB=R1*TD:PX=PEL-SLED:TN=RCB*SIN(PX):TD=RCB*COS(PX)+SRV:GOSUB 16300:XLAM=T+SLED:PDE=SQR(TN*TN+TD*TD+RSB*RSB):TN=RSB/PDE:GOSUB 16250:XB=T:GOSUB 15000:GOSUB 20000
  19. 30465 IF Z<>0 THEN NS=NS+1:J=INT(ULY*Y+JY+.5)\8:ACT(J,0)=ACT(J,0)+1:ACT(J,ACT(J,0))=-KN-1
  20. 30466 PL(KN,0)=RA:PL(KN,1)=DEC:RETURN
  21. 30500 X=SRV*COS(SLED):Y=SRV*SIN(SLED):ZZ=Y*SEO:Y=Y*CEO
  22. 30505 T0=(JD#-2415020.313#)/36524.2199#:TAU=(2433282.423#-JD#)/36524.2199#
  23. 30510 C=((.018#*TAU+.302#)*TAU+(2304.25#+1.396*T0))*TAU*RF/3600:T=((-.042#*TAU-.426#)*TAU+(2004.682#-.853#*T0))*TAU*RF/3600:Z=C+(.001#*TAU+.791#)*TAU*TAU*RF/3600
  24. 30515 CC=COS(C):SC=SIN(C):ST=SIN(T):CT=COS(T):CZ=COS(Z):SZ=SIN(Z):XS=X*(CC*CZ*CT-SC*SZ)-Y*(CC*SZ+SC*CZ*CT)-ZZ*CZ*ST:YS=X*(SC*CZ+CC*SZ*CT)+Y*(CC*CZ-SC*SZ*CT)-ZZ*SZ*ST:ZS=X*CC*ST-Y*SC*ST+ZZ*CT:RETURN
  25. 30550 CF=COS(CMO):SO=SIN(CMO):E=23.4457889#*RF:CEE=COS(E):SE=SIN(E):SI=SIN(CMI):CI=COS(CMI):TN=CF:TD=-SO*CI:GOSUB 16300:CAA=T:CA=SQR(TN*TN+TD*TD):TN=SO*CEE:TD=CF*CI*CEE-SI*SE:GOSUB 16300:CAB=T:CB=SQR(TN*TN+TD*TD):TN=SO*SE:TD=CF*CI*SE+SI*CEE:GOSUB 16300
  26. 30555 CAC=T:CC=SQR(TN*TN+TD*TD):P=(JD#-CMT#)*CMN*RF:EP=CME:GOSUB 16990:TN=SQR(1#+EP)*SIN(E0/2):TD=SQR(1#-EP)*COS(E0/2):GOSUB 16300:CMV=2*T+CMP:CMR=CMA*(1-EP*COS(E0)):CX=CMR*CA*SIN(CAA+CMV):CY=CMR*CB*SIN(CAB+CMV):CZ=CMR*CC*SIN(CAC+CMV)
  27. 30560 CY=YS+CY:CX=XS+CX:CZ=ZS+CZ
  28. 30565 DELT=SQR(CX*CX+CY*CY+CZ*CZ):P=(JD#-.0057756*DELT-CMT#)*CMN*RF:EP=CME:GOSUB 16990:TN=SQR(1#+EP)*SIN(E0/2):TD=SQR(1#-EP)*COS(E0/2):GOSUB 16300:CMV=2*T+CMP:CMR=CMA*(1-EP*COS(E0)):CX=CMR*CA*SIN(CAA+CMV):CY=CMR*CB*SIN(CAB+CMV):CZ=CMR*CC*SIN(CAC+CMV)
  29. 30570 CY=YS+CY:CX=XS+CX:CZ=ZS+CZ:TN=CY:TD=CX:GOSUB 16300:RA=T/HF:IF RA<0 THEN RA=RA+24
  30. 30583 TN=CZ/SQR(CX*CX+CY*CY+CZ*CZ):GOSUB 16250:DEC=T/RF
  31. 30584 CEK=CE:CTEK=CTE:STEK=STE:ZEK=ZE:FT#=(JD#-2433282.423#)/36524.2199#
  32. 30585 CE=((.018#*FT#+.302#)*FT#+2304.948#)*FT#*RF/3600#:ZE=((.019#*FT#+1.093#)*FT#+2304.948#)*FT#*RF/3600#:STE=((-.042#*FT#-.426#)*FT#+2004.255#)*FT#*RF/3600#:CTE=COS(STE):STE=SIN(STE)
  33. 30590 ON IPREC GOSUB 19900,20000:CE=CEK:CTE=CTEK:STE=STEK:SE=SEK:RA=(RI+RAO)/HF:TN=SD:TD=CD:GOSUB 16300:DEC=T/RF:RETURN
  34. 30600 IF ERR=5 THEN RESUME NEXT ELSE IF ERR=10 THEN ERASE PL:RESUME ELSE ON ERROR GOTO 9000:GOTO 9000
  35. 30900 'JD from yf mf df hf mif
  36. 30910 DD=DF+(HF+(MIF/60))/24:YY=YF:MM=MF:IF MF<3 THEN YY=YY-1:MM=MM+12
  37. 30920 B=0:IF(YF+MF/100+DD/10000)>=1582.1015# THEN A=INT(YY/100):B=2-A+INT(A/4)
  38. 30930 C=0:IF YY<0 THEN C=.25
  39. 30940 JD#=INT(365.25*YY+C)+INT(30.6001#*(MM+1))+DD+1720994.5#+B:RETURN
  40. 31000 IF IDONE=0 THEN ICR=1:GOSUB 6000 ELSE FOR N=0 TO 12:OB$(N)=CHR$(176):NEXT N
  41. 31003 CLS:WIDTH 40:SCREEN 0:LOCATE 3,12:COLOR IGR:PRINT"What is the";:COLOR IYL:LOCATE 4,12:PRINT"right ascension":COLOR IGR:LOCATE 5,12:PRINT"of your object?"
  42. 31006 IF OV=1 THEN LOCATE 1,12:COLOR IYL:PRINT"Please try again:":OV=0
  43. 31009 LOCATE 8,12:I$=CHR$(176):COLOR IYL:PRINT I$+I$;:COLOR IGR:PRINT" h. ";:COLOR IYL:PRINT I$+I$;:COLOR IGR:PRINT" m. ";:COLOR IYL:PRINT I$+I$;:COLOR IGR:PRINT" s.":LOCATE 11,12:PRINT"The";:COLOR IYL:PRINT" declination";:COLOR IGR:PRINT"?"
  44. 31012 LOCATE 14,12:COLOR IYL:PRINT I$+I$+I$;:COLOR IGR:PRINT " "CHR$(248);:COLOR IYL:PRINT " "I$+I$;:COLOR IGR:PRINT" ' ";:COLOR IYL:PRINT I$+I$;:COLOR IGR:PRINT " "CHR$(34)
  45. 31013 LOCATE 17,12:PRINT"The ";:COLOR IYL:PRINT"epoch ";:COLOR IGR:PRINT"of your":LOCATE 18,12:PRINT"coordinates?":LOCATE 21,12:COLOR IYL:PRINT I$+I$+I$+I$
  46. 31015 LOCATE 24,12:COLOR IGR:PRINT"Press the ";:COLOR IBW:PRINT"ENTER";:COLOR IGR:PRINT" key";:LOCATE 25,12:PRINT"when you are finished.";:K=0:IBL=IYL+8:GOTO 31021
  47. 31018 PRINT OB$(K):K=(K+1) MOD 14
  48. 31021 IY=VAL(LEFT$(OBB$(K),2)):IX=VAL(RIGHT$(OBB$(K),2)):LOCATE IY,IX:COLOR IBL:PRINT OB$(K):COLOR IYL:LOCATE 13,9:IF K=6 THEN PRINT"+ or -"; ELSE PRINT STRING$(6,32)
  49. 31022 LOCATE 20,9:IF K=13 THEN PRINT"1950 or 2000"ELSE PRINT STRING$(12,32)
  50. 31023 LOCATE IY,IX
  51. 31024 A$=INKEY$:IF A$=""THEN 31024
  52. 31027 IF A$=CHR$(27) THEN 4000
  53. 31030 IF A$=CHR$(13) THEN 31060
  54. 31033 IF LEN(A$)=2 THEN BA$=RIGHT$(A$,1) ELSE BA$="A"
  55. 31036 IF BA$=CHR$(77) THEN 31018
  56. 31039 IF BA$=CHR$(75) THEN PRINT OB$(K):K=(K+13) MOD 14:GOTO 31021
  57. 31042 IF BA$=CHR$(72) AND K>5 THEN PRINT OB$(K):IF K<8 THEN K=K-6:GOTO 31021 ELSE IF K<12 THEN K=K-7:GOTO 31021 ELSE IF K=13 THEN K=6:GOTO 31021 ELSE K=K-8:GOTO 31021
  58. 31045 IF BA$=CHR$(80) AND K<13 THEN PRINT OB$(K):IF K=4 THEN K=12:GOTO 31021 ELSE IF K<2 THEN K=K+6:GOTO 31021 ELSE IF K>5 THEN K=13:GOTO 31021 ELSE K=K+7:GOTO 31021
  59. 31048 IF A$=CHR$(8) THEN PRINT OB$(K):K=(K+13)MOD 14:GOTO 31021
  60. 31051 IF K=6 THEN IF A$<>"-" THEN OB$(K)="+":GOTO 31018 ELSE OB$(K)="-":GOTO 31018
  61. 31052 IF K=13 THEN IF A$<>"1"THEN OB$(K)="2":PRINT "2000":K=0:GOTO 31021 ELSE PRINT"1950":OB$(K)="1":K=0:GOTO 31021
  62. 31054 IF A$<":"AND A$>"/"THEN OB$(K)=A$:GOTO 31018
  63. 31057 GOTO 31024
  64. 31060 GOSUB 30000:IK=0:FOR I=0 TO 12:IF OB$(I)=CHR$(176) THEN OB$(I)="0":IK=IK+1
  65. 31063 NEXT I:RA=VAL(OB$(0)+OB$(1))+(VAL(OB$(2)+OB$(3)))/60+(VAL(OB$(4)+OB$(5)))/3600:DEC=VAL(OB$(7)+OB$(8))+(VAL(OB$(9)+OB$(10)))/60+(VAL(OB$(11)+OB$(12)))/3600:IF OB$(6)="-"THEN DEC=-DEC
  66. 31066 OV=0:IF IK>10 OR RA>24 OR RA<0 OR DEC>90 OR DEC<-90 THEN OV=1:GOTO 31000
  67. 31067 IF OB$(13)="1"THEN GOSUB 30584 ELSE ON IPREC GOSUB 19900,20000
  68. 31069 GOSUB 20300:DEF SEG:POKE &H4E,IC1:IF Z=0 THEN 31075 ELSE ID=3:IS=3:IR=0:IX=0:IF X<160 THEN IX=182:IR=1:IS=26
  69. 31072 DRAW"bm =x;,=y; c=ic1; e4 g8 e4 f4 h8 f4 bm =ix;,6 f8 h4 e4 g8":LOCATE 2,IS:PRINT "is your object.":IS=1:IF IR=1 THEN IS=24:GOTO 8419 ELSE GOTO 8419
  70. 31075 LOCATE 1,1:PRINT"Your object is":LOCATE 2:PRINT"not visible at":LOCATE 3:PRINT"this time.":ID=4:IR=0:IS=1:GOTO 8419
  71. 40000 '
  72.